-- This file contains the main program, which runs various tests on
-- your implementation of finite channels.  Feel free to edit this
-- file as you like during testing (for example, to enable debug
-- tracing).  But make sure that your solution passes all tests under
-- the original, unmodified version.

import Control.Concurrent
import FiniteChan
import Control.Monad
import System.Exit
import System.IO.Unsafe
import Data.IORef

rounds = 1000

delayUnit = 1000*200 -- 0.2 seconds

assert b s = 
  if b then return () else do
  putStrLn $ "assertion failed: " ++ s
  exitWith (ExitFailure 1)

beginTest s = putStrLn $ "Starting test procedure: " ++ s

endTest = do
  putStrLn "Test passed"
  putStrLn ""

---------------------------------------------
-- Debugging support (change the definition of dbg to the commented-out one to enable)

dbg s = do return ()
-- dbg s = do id <- myThreadId;  putStrLn $ "[" ++ (show id) ++ "] " ++ s

newFC x = do
  dbg $ "newFiniteChan " ++ (show x) ++ " called"
  c <- newFiniteChan x
  dbg $ "newFiniteChan " ++ (show x) ++ " returned"
  return c

readFC c = do
  dbg $ "readFiniteChan called"
  x <- readFiniteChan c
  dbg $ "readFiniteChan returned, result=" ++ (show x)
  return x

writeFC c x = do
  dbg $ "writeFiniteChan " ++ (show x) ++ " called"
  writeFiniteChan c x
  dbg $ "writeFiniteChan " ++ (show x) ++ " returned"


---------------------------------------------------
test1 = forM [1..5] $ \i -> test1a i

-- basic test: fill,empty,fill,empty

test1a x = do
  beginTest $ "test1:"++(show x)
  fc <- newFC x
  forM [1..x] $ \i-> writeFC fc i
  forM [1..x] $ \i-> do
    j <- readFC fc
    assert (i==j) "FIFO order not respected"

  forM [x+1..2*x] $ \i-> writeFC fc i
  forM [x+1..2*x] $ \i-> do
    j <- readFC fc
    assert (i==j) "FIFO order not respected"

  endTest
--------------------------------------------------------

-- two threads doing producer+consumer

test2 = forM [1..5] $ \i -> test2a i

test2a size = do
  beginTest $ "test2:"++(show size)
  fc <- newFC size
  forkIO (producer fc)
  consumer fc
  forkIO (consumer fc)
  producer fc
  endTest
 where
  producer fc = do
    forM [1..rounds] $ \i-> do
      writeFC fc i
    return ()
  consumer fc = do
    forM [1..rounds] $ \i-> do
      j <- readFC fc
      assert(i==j) "FIFO order not respected"
    return ()


--------------------------------------------
test3 = forM [1..5] $ \i -> test3a i

-- when consumer is slow, the queue should always be full

test3a size = do
  beginTest $ "test3:"++(show size)
  fc <- newFC size
  forkIO (producer fc)
  consumer fc
  endTest
 where
  counter = unsafePerformIO (newMVar 0)
  producer fc = do
    forM [1..rounds] $ \i-> do
      writeFC fc i
      modifyMVar_ counter $ \c-> do
        -- putStrLn $ (show c) ++ "<" ++ (show size)
        assert (c<size) "Queue size not within limit"
        return (c+1)
    return ()
  consumer fc = do
    forM [1..10] $ \i-> do
      threadDelay delayUnit
      modifyMVar_ counter $ \c-> do
         -- putStrLn $ (show c) ++ "<=" ++ (show size)
         assert (c==size) "Queue should always be full with a slow reader"
         return (c-1)
      j <- readFC fc
      assert(i==j) ""
    return ()


--------------------------------------------
test4 = forM [1..5] $ \i -> test4a i

-- when producer is slow, the queue is always empty

test4a size = do
  beginTest $ "test4:"++(show size)
  fc <- newFC size
  forkIO (consumer fc)
  producer fc
  endTest
 where
  counter = unsafePerformIO (newMVar 0)
  producer fc = do
    forM [1..5] $ \i-> do
      threadDelay delayUnit
      modifyMVar_ counter $ \c-> do
        -- putStrLn $ (show c) ++ "<" ++ (show size)
        assert (c==0) "Queue should always be empty with a slow writer"
        return (c+1)
      writeFC fc i
    return ()
  consumer fc = do
    forM [1..rounds] $ \i-> do
      j <- readFC fc
      assert(i==j) ""
      modifyMVar_ counter $ \c-> do
         -- putStrLn $ (show c) ++ "<=" ++ (show size)
         assert (c<=size) "Queue size not within limit"
         return (c-1)
    return ()

--------------------------------------------------

test5 = forM [1..5] $ \i -> test5a i

-- multiple producer/consumer threads working on both ends of queue
-- total sent = total received
-- all threads must finish their work, no one should be blocked forever

test5a size = do
  beginTest $ "test5:"++(show size)
  fc1 <- newFC size
  fc2 <- newFC 1
  forM [1..nums] $ \_ -> forkIO (producer fc1)
  forM [1..nums] $ \_ -> forkIO (consumer fc1 fc2)
  s <- newIORef 0
  forM [1..(nums*rounds)] $ \_ -> do
    i <- readFC fc2
    modifyIORef s (+i)
  result <- readIORef s
  assert (result== nums * (sum [1..rounds])) "total sent <> total received"
  endTest
 where
  nums = 10 
  producer fc = do
    forM [1..rounds] $ \i -> writeFC fc i
    return ()
  consumer fc1 fc2 = do
    forM [1..rounds] $ \_ -> do
      i <- readFC fc1
      writeFC fc2 i
    return ()

----------------------------------------------------------------
--------------------------------------------
test6 = forM [1..5] $ \i -> test6a i

-- multiple producer + one slow consumer
-- the queue should be always full

test6a size = do
  beginTest $ "test6:"++(show size)
  fc <- newFC size
  forM [1..5] $ \_ -> forkIO (producer fc)
  consumer fc
  endTest
 where
  counter = unsafePerformIO (newMVar 0)
  producer fc = do
    forM [1..rounds] $ \i-> do
      writeFC fc i
      modifyMVar_ counter $ \c-> do
        -- putStrLn $ (show c) ++ "<" ++ (show size)
        assert (c<size) "queue size not within limit"
        return (c+1)
    return ()
  consumer fc = do
    forM [1..10] $ \i-> do
      threadDelay delayUnit
      modifyMVar_ counter $ \c-> do
         -- putStrLn $ (show c) ++ "<=" ++ (show size)
         assert (c==size) "queue should always be full with slow reader"
         return (c-1)
      readFC fc
    return ()

----------------------------
--------------------------------------------
test7 = forM [1..5] $ \i -> test7a i

-- multiple consumer + one slow producer
-- the queue should be always empty

test7a size = do
  beginTest $ "test7:"++(show size)
  fc <- newFC size
  forM [1..5] $ \_-> forkIO (consumer fc)
  producer fc
  endTest
 where
  counter = unsafePerformIO (newMVar 0)
  producer fc = do
    forM [1..10] $ \i-> do
      threadDelay delayUnit
      modifyMVar_ counter $ \c-> do
        -- putStrLn $ (show c) ++ "<" ++ (show size)
        assert (c==0) "queue should always be empty with slow writer"
        return (c+1)
      writeFC fc i
    return ()
  consumer fc = do
    forM [1..rounds] $ \i-> do
      j <- readFC fc
      modifyMVar_ counter $ \c-> do
         -- putStrLn $ (show c) ++ "<=" ++ (show size)
         assert (c<=size) "queue size not within limit"
         return (c-1)
    return ()

------------------------------------------

-- temporal ordering test:
-- multiple producer + one consumer
-- whoever gets blocked first should be unblocked first

test8 = forM [1..2] $ \i -> test8a i

test8a size = do
  beginTest $ "test8:"++(show size)
  fc <- newFC size
  forM [1..size] $ \_ -> writeFC fc 0
  forM [1..5] $ \idx-> forkIO (producer idx fc)
  threadDelay (delayUnit*6)
  forM [1..size] $ \_ -> do 
    j <- readFC fc
    threadDelay delayUnit
    assert (j==0) "queue FIFO ordering"
  forM [1..5] $ \i -> do
    j <- readFC fc
    threadDelay delayUnit
    assert (i==j) "FIFO ordering of thread blocking: whoever gets blocked first should be unblocked first"
  forM [1..5] $ \i -> do
    j <- readFC fc
    threadDelay delayUnit
    assert (i==j) "FIFO ordering of thread blocking: whoever gets blocked first should be unblocked first"  
  endTest
 where
  producer idx fc = do 
    threadDelay (delayUnit*idx)
    writeFC fc idx
    writeFC fc idx


------------------------------------------

-- temporal ordering test:
-- multiple consumer + one producer
-- whoever gets blocked first should be unblocked first

test9 = do
  beginTest $ "test9"
  fc <- newFC 1
  forM [1..5] $ \idx-> forkIO (consumer idx fc)
  threadDelay (delayUnit*6)
  forM [1..5] $ \i -> do
    writeFC fc i
    threadDelay delayUnit
  forM [1..5] $ \i -> do
    writeFC fc i
    threadDelay delayUnit
  endTest
 where
  consumer idx fc = do
    threadDelay (delayUnit*idx)
    j <- readFC fc
    assert (j==idx) "FIFO ordering of thread blocking: whoever gets blocked first should be unblocked first"
    j <- readFC fc
    assert (j==idx) "FIFO ordering of thread blocking: whoever gets blocked first should be unblocked first"


main = do
  test1
  test2
  test3
  test4
  test5  
  test6
  test7
  --test8
  --test9
